home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcpm.arc / CPAUPD.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  2.5 KB  |  84 lines
  1. 20  CLOSE
  2. 100  REM CPAUPD   UPDATE INPUT FILE FOR ACTUAL TIMES
  3. 110  DEFINT B-Z:DEFSNG A
  4. 112  DIM X$(12),A6(500)
  5. 114  FOR I=1 TO 12
  6. 116  READ X$(I)
  7. 118  NEXT I
  8. 120  DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  9. 122  DIM S(500),F(500),D$(500),D(500),O2(500)
  10. 124  DIM A(1500),H3(100),B(500),S$(48),R3(500),C(500)
  11. 128  B4=VAL(MID$(DATE$,1,2))
  12. 130  B5=VAL(MID$(DATE$,4,2))
  13. 132  B6=VAL(MID$(DATE$,9,2))
  14. 150  GOSUB 5000 'READ INPUT FILE
  15. 200  ON ERROR GOTO 6500
  16. 205  H$=F$+".UPD"
  17. 210  OPEN H$ FOR INPUT AS #2
  18. 215  INPUT #2,C4,C5,C6  'DATE OF CREATION OF UPDATE FILE
  19. 220  J=0
  20. 230  J=J+1
  21. 240  IF EOF(2) THEN 280
  22. 250  INPUT #2,D$,S,F,D2,A6
  23. 255  IF A6=0 THEN 230
  24. 260  GOSUB 2000
  25. 265  PRINT "**** ";D$;" UPDATED TO";D2;T6$;" ****"
  26. 270  GOTO 230
  27. 280  IF N<>J-1 THEN PRINT "**** WARNING - WRONG NUMBER OF ENTRIES IN UPDATE FILE ****"
  28. 290  CLOSE #2
  29. 300  PRINT "File ";F$;" updated - O.K. to write to disk (Y/N) ";
  30. 310  INPUT Q$:IF LEFT$(Q$,1)="N" THEN 320 ELSE 330
  31. 320  INPUT "Press ENTER to return to the main menu ",Q$:CHAIN "CPAMENU"
  32. 330  GOSUB 3000 'WRITE TO DISK
  33. 340  CHAIN "CPAMENU"
  34. 400  PRINT "**** UPDATE FILE ";H$;" NOT FOUND - CREATE WITH OPTION 5 ****"
  35. 410  PRINT :GOTO 320
  36. 2000  REM SUBROUTINE TO COMPARE AND CHANGE ACTUAL TIMES
  37. 2010  FOR I=1 TO N
  38. 2020  IF S(I)<>S THEN 2100
  39. 2030  IF F(I)<>F THEN 2100
  40. 2040  IF D$(I)<>D$ THEN PRINT "**** DESCRIPTIONS VARY - ";D$(I);" - ";D$;" ****" ELSE 2070
  41. 2050  INPUT "Enter Y (O.K.), N for wrong activity, or Q to Quit (abort here) (Y/N/Q) ";Q$
  42. 2060  IF Q$="Q" THEN CLOSE #2:CHAIN "CPAMENU"
  43. 2070  D(I)=D2
  44. 2100  NEXT
  45. 2110  RETURN
  46. 3000  REM **** UPDATING INPUT FILE ******************
  47. 3060  G$=F$+".CPM"
  48. 3070  OPEN G$ FOR OUTPUT AS #3
  49. 3080  WRITE #3,P$,T6$,DA$
  50. 3100  FOR I=1 TO N
  51. 3120  WRITE #3,D$(I),S(I),F(I),O2(I),D(I),A6(I),R3(I),B(I),C(I)
  52. 3140  IF I/10=INT(I/10) THEN PRINT I;
  53. 3150  NEXT
  54. 3180  CLOSE #3
  55. 3190  PRINT " **** FILE ";G$;" UPDATED ****"
  56. 3200  RETURN
  57. 5000  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  58. 5010  INPUT "Enter the name of the input file [.CPM] ";G$
  59. 5015  IF G$="Q" OR G$="QUIT" THEN 3500
  60. 5020  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  61. 5030  IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
  62. 5035  ON ERROR GOTO 5300
  63. 5037  G$=F$+".CPM"
  64. 5040  OPEN G$ FOR INPUT AS #3
  65. 5050  INPUT #3,P$,T6$,DA$
  66. 5060  I=0
  67. 5070  I=I+1
  68. 5080  IF EOF(3) THEN 5130
  69. 5090  INPUT #3,D$(I),S(I),F(I),O2(I),D(I),A6(I),R3(I),B(I),C(I)
  70. 5110  IF I/10=INT(I/10) THEN PRINT I;
  71. 5120  GOTO 5070
  72. 5130  N=I-1
  73. 5140  M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  74. 5150  CLOSE #3
  75. 5160  PRINT " **** INPUT FILE READ ****"
  76. 5170  RETURN
  77. 5300  PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 5000
  78. 6500  REM ERRORS IN FILE HANDLING
  79. 6510  IF ERR=53 THEN BEEP:PRINT "**** UPDATE FILE MUST BE CREATED FIRST AND EXIST ON THE DISK ****":PRINT
  80. 6515  IF ERR<>53 THEN 11000  'GENEARAL ERROR
  81. 6520  RESUME 320
  82. 11000  PRINT "ERROR NUMBER";ERR;"AT LINE NUMBER";ERL:PRINT "**** PLEASE NOTE FOR FUTURE USE AND DEBUGGING ****"
  83. 11010  GOTO 320
  84.